temp-bikes/00 ax-till-limpa/Stepping through the whole thing.R

In ooelrich/oscbvar: Stuff for Bayesian vector autoregressions

############################################################
### 1. Generate predictions                              ###
############################################################

# Predictions for the agents are generated using the script bikes_atom
# in data-raw. They are all available in bikes_atom (part of the pkg).
# To access a single models predictions, use:

bikes_reg <- bikes_atom[method == "BREGLOG"]
bikes_sv <- bikes_atom[method == "SVBVAR"]
bikes_bart <- bikes_atom[method == "BART"]

############################################################
### 2. Generate a data frame with pooling-variables      ###
############################################################

# Using all the continuous varibles from bikesharing
sotw_cont <- subset(bikes_d_log, select = c(t, temp, hum, windspeed))

# Variables to straight up match on. Family day är thanksgiving,
# christmas eve, and christmas day
matchi <- data.frame(t = 1:730, family_day = 0)
matchi[c(327, 357:358, 691, 723:724), 2] <- 1

############################################################
### 3. Generate aggregate predictions                    ###
############################################################

# Data frame to store the aggregate predictions in
df_agg <- gen_atomic_df()

# Generate the baseline aggregations
gg <- gen_gewisano(bikes_atom, 201, pratig = TRUE)
df_gewisano <- gg[[1]]
gewisano_weights <- gg[[2]] # gewisano weights over time
df_agg <- rbind(df_agg, df_gewisano)

# Generate the caliper weights
weight_df <- caliper_relevance_new(
    bikes_atom,
    sotw_cont,
    670,
    cw = 0.1,
    matching_vars = NULL # matchi
)

# Calculate relevance adjusted logscore for each observation at each time        
RAL_data <- RAL_calculator(weight_df, bikes_atom)
df_cal_prop <- gen_RAA(RAL_data, "propto", "caliper")
df_agg <- rbind(
    df_agg,
    df_cal_prop
)

# Look at the weights for the caliper method over time
cal_wt <- RAL_data[, .(method, weight = exp(RAL)/sum(exp(RAL))), by = .(t)]

# Plot the aggregate predictions
ggplot(df_agg[t >= 670], aes(x = t, y = lpdens, color = method)) + geom_line()